home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / shazam.exe / GDIALOG.IMP < prev    next >
Text File  |  1992-09-01  |  14KB  |  378 lines

  1.    {*******************************************************************
  2.  
  3.    GDIALOG.IMP
  4.  
  5.    *******************************************************************}
  6.    {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
  7.  
  8.    DIALOG UTILITIES
  9.  
  10.    |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  11.    {===================================================================
  12.  
  13.    COPY DIALOG - Otherwise known as "reverse polymorphism"
  14.  
  15.    ===================================================================}
  16. function CopyDialog ( DSource , DTarget : PDialog ) : boolean ;
  17.    {-------------------------------------------------------------------
  18.    ACTION
  19.    -------------------------------------------------------------------}
  20. procedure Action ( P : PView ) ; FAR ;
  21. begin
  22.    P^.Owner                  := DTarget ;
  23. end ;
  24.    {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  25.    PROCESS
  26.    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
  27. var
  28.    R                         : TRect ;
  29. begin
  30.    CopyDialog                := FALSE ;                    { set flag }
  31.    if DSource = NIL then EXIT ;                       { nothing to do }
  32.    if DTarget = NIL then EXIT ;                       { nothing to do }
  33.    DSource^.GetBounds ( R ) ;                                { extent }
  34.    {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  35.    TARGET - change elements, then switch ownership.
  36.    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
  37.    with DTarget^ do
  38.    begin
  39.       Dispose ( Frame , Done ) ;                               { free }
  40.       if Title <> NIL then
  41.          DisposeStr ( Title ) ;                                { free }
  42.       ChangeBounds ( R ) ;                                   { extent }
  43.    {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  44.    COMPONENTS
  45.    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
  46.       Frame                  := DSource^.Frame ;             { screen }
  47.       Title                  := DSource^.Title ;             { screen }
  48.       Buffer                 := DSource^.Buffer ;            { screen }
  49.       Next                   := DSource^.Next ;            { sub-view }
  50.       Last                   := DSource^.Last ;            { sub-view }
  51.       Current                := DSource^.Current ;         { sub-view }
  52.       Owner                  := DSource^.Owner ;             { parent }
  53.    end ;
  54.    {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  55.    SOURCE - make sure we don't dispose stuff we need!
  56.    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
  57.    with DSource^ do
  58.    begin
  59.       Frame                  := NIL ;                        { screen }
  60.       Title                  := NIL ;                        { screen }
  61.       Buffer                 := NIL ;                        { screen }
  62.       Next                   := NIL ;                      { sub-view }
  63.       Last                   := NIL ;                      { sub-view }
  64.       Current                := NIL ;                      { sub-view }
  65.       Owner                  := NIL ;                        { parent }
  66.    end ;
  67.    Dispose ( DSource , Done ) ;                       { dump original }
  68.  
  69.    DTarget^.ForEach ( @Action ) ;                            { fields }
  70.  
  71.    CopyDialog                := TRUE ;                     { set flag }
  72. end ;
  73.    {===================================================================
  74.  
  75.    SCROLLBAR - Vertical, either side
  76.  
  77.    ===================================================================}
  78. function AddVScrollBar ( G : PGroup ; Right : boolean ) : PScrollBar ;
  79. var
  80.    R                         : TRect ;
  81.    SB                        : PScrollBar ;
  82. begin
  83.    G^.GetExtent ( R ) ;
  84.    if Right then
  85.    begin
  86.       R.A                    := R.B ;
  87.       dec ( R.A.X ) ;                        { go left, to be visible }
  88.       dec ( R.B.Y ) ;                            { don't cover corner }
  89.       R.A.Y                  := 1 ;              { don't cover corner }
  90.    end
  91.    else
  92.    begin
  93.       R.B.X                  := R.A.X + 1 ; { go right, to be visible }
  94.       R.A.Y                  := 1 ;              { don't cover corner }
  95.       dec ( R.B.Y ) ;                            { don't cover corner }
  96.    end ;
  97.    New ( SB , Init ( R ) ) ;
  98.    G^.Insert ( SB ) ;
  99.    AddVScrollBar             := SB ;
  100. end ;
  101.    {===================================================================
  102.  
  103.    SCROLLBAR - Horizontal, top or bottom
  104.  
  105.    ===================================================================}
  106. function AddHScrollBar ( G : PGroup ; Bottom : boolean ) : PScrollBar ;
  107. var
  108.    R                         : TRect ;
  109.    SB                        : PScrollBar ;
  110. begin
  111.    G^.GetExtent ( R ) ;
  112.    if Bottom then
  113.    begin
  114.       R.A.Y                  := R.B.Y - 1 ;
  115.       R.A.X                  := 1 ;
  116.       dec ( R.B.X ) ;                            { don't cover corner }
  117.    end
  118.    else
  119.    begin
  120.       R.B.Y                  := R.A.Y + 1 ;
  121.       R.A.X                  := 1 ;
  122.       dec ( R.B.X ) ;
  123.    end ;
  124.    New ( SB , Init ( R ) ) ;
  125.    G^.Insert ( SB ) ;
  126.    AddHScrollBar             := SB ;
  127. end ;
  128.    {===================================================================
  129.  
  130.    COUNT - Views which can hold data (non-static).
  131.  
  132.    ===================================================================}
  133. function TActiveCount ( D : PDialog ) : byte ;
  134. var
  135.    x                         : byte ;
  136.  
  137. procedure DoThis ( P : PView ) ; FAR ;
  138. begin
  139.    if P^.DataSize = 0 then EXIT ;
  140.    inc ( x ) ;
  141. end ;
  142.  
  143. begin
  144.    x                         := 0 ;
  145.    D^.ForEach ( @DoThis ) ;
  146.    TActiveCount               := x ;
  147. end ;
  148.    {===================================================================
  149.  
  150.    Return pointer to view with data.
  151.  
  152.    ===================================================================}
  153. function DataRecPtr ( D : PDialog ; Fnum : byte ) : pointer ;
  154. var
  155.    x                         : byte ;
  156.    {-------------------------------------------------------------------
  157.    -------------------------------------------------------------------}
  158. function DoThis ( P : PView ) : boolean ; FAR ;
  159. var
  160.    S                         : string ;
  161. begin
  162.    DoThis                    := FALSE ;
  163.    if P^.DataSize = 0 then EXIT ;
  164.    dec ( x ) ;
  165.    if x <> Fnum then EXIT ;
  166.    DoThis                    := TRUE ;
  167. end ;
  168.    {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  169.    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
  170. begin
  171.    DataRecPtr                := NIL ;
  172.    x                         := TActiveCount ( D ) + 1 ;
  173.    if FNum > x then EXIT ;
  174.    DataRecPtr                := D^.FirstThat ( @DoThis ) ;
  175. end ;
  176.    {===================================================================
  177.  
  178.    SET - Reference View's data by view order number.
  179.  
  180.    ===================================================================}
  181. procedure SetDataRec ( D : PDialog ; Fnum : byte ; Data : pointer ) ;
  182. var
  183.    P                         : PView ;
  184. begin
  185.    P                         := DataRecPtr ( D , Fnum ) ;
  186.    if P = NIL then EXIT ;
  187.    P^.SetData ( Data^ ) ;
  188.    P^.DrawView ;
  189. end ;
  190.    {===================================================================
  191.  
  192.    GET - Reference View's data by view order number.
  193.  
  194.    ===================================================================}
  195. procedure GetDataRec ( D : PDialog ; Fnum : byte ; Data : pointer ) ;
  196. var
  197.    P                         : PView ;
  198. begin
  199.    P                         := DataRecPtr ( D , Fnum ) ;
  200.    if P = NIL then EXIT ;
  201.    P^.GetData ( Data^ ) ;
  202. end ;
  203.    {===================================================================
  204.  
  205.    BUTTON ON/OFF
  206.  
  207.    ===================================================================}
  208. procedure SetButtons ( D : PDialog ; On : boolean ) ;
  209.  
  210. procedure DoThis ( P : PView ) ; FAR ;
  211. begin
  212.    if TypeOf ( P^ ) <> TypeOf ( TButton ) then EXIT ;
  213.    if On then
  214.       P^.Show
  215.